#!/usr/bin/perl
# $Id: mapup.cgi 319 2006-05-09 05:49:46Z ogawa $
use strict;
#use lib 'extlib';

package MapUp;
use CGI::Fast;
use LWP::UserAgent;
use Net::Trackback::Server;
use DBI qw(:sql_types);
use XML::Atom::Feed;
use XML::Atom::Entry;
use XML::Atom::Person;
use Template;

our $SCREEN_XSL = 'screen.xsl';

my $geo_ns = XML::Atom::Namespace->new(geo => 'http://www.w3.org/2003/01/geo/wgs84_pos#');

*XML::Atom::Entry::geo = sub {
    { lat => $_[0]->get($geo_ns, 'lat'), long => $_[0]->get($geo_ns, 'long') };
};

sub new {
    my $class = shift;
    my $dbname = shift
	or die "No SQLite DBName provided.";
    my $key = shift
	or die "No Google Maps API key provided.";
    my $param = {
	dbh => DBI->connect('dbi:SQLite:dbname=' . $dbname, '', '',
			    { RaiseError => 0, PrintError => 0 }),
	key => $key,
    };
    bless $param, $class;
}

sub request {
    my $this = shift;
    $this->{cgi} = CGI::Fast->new;
}

# get coords feed
sub get_coords {
    my($this, $args) = @_;
    my($lat, $lng) = ($args =~ m/(-?[\d.]+),(-?[\d.]+)/);
    my $q = $this->{cgi};

    unless (defined $lat && abs($lat) <= 90 &&
	    defined $lng && abs($lng) <= 180) {
	print $q->header('text/html', '403 Forbidden'), "403 Forbidden\n";
	return;
    }

    my $feed = $this->get_coords_feed($lat, $lng);
    if ($q->param('view') eq 'html') {
	print $q->header('text/html');
	my $tmpl = get_tmpl();
	my $tt = Template->new;
	$tt->process(\$tmpl, { lat => $lat, lng => $lng, q => $q,
			       feed => $feed, key => $this->{key} })
	    or print $tt->error;
    } else {
	print $q->header('text/xml'), $feed->as_xml;
    }
}

sub get_coords_feed {
    my($this, $lat, $lng) = @_;
    my $q = $this->{cgi};
    my $dbh = $this->{dbh};

    my $feed = XML::Atom::Feed->new(Version => 1);
#    $feed->{doc}->insertProcessingInstruction('xml-stylesheet',
#	qq{type="text/xsl" media="screen" href="$SCREEN_XSL"});

    $feed->title("MapUp coordinates ($lat,$lng)");
    $feed->id('tag:' . $q->server_name . ',2006:' . $q->url(-absolute => 1, -path_info => 1));
    $feed->add_link({ rel => 'self', type => 'application/atom+xml',
		      href => $q->url(-path_info => 1) });
    $feed->add_link({ rel => 'alternate', type => 'text/html',
		      href => $q->url(-path_info => 1) . '?view=html' });
    my @ts = gmtime(time);
    $feed->updated(sprintf('%04d-%02d-%02dT%02d:%02d:%02dZ',
			   $ts[5]+1900, $ts[4]+1, @ts[3,2,1,0]));

    my $sql = "select *,(lat-$lat)*(lat-$lat)+(lng-$lng)*(lng-$lng) as dist from tbping order by dist asc, modified_on desc limit 20\n";

    my $sth = $dbh->prepare($sql);
    my($id, $lat, $lng, $title, $excerpt, $url, $blog_name, $created_on, $modified_on, $dist);
    $sth->bind_columns(undef, \($id, $lat, $lng, $title, $excerpt, $url,
		       $blog_name, $created_on, $modified_on, $dist));
    $sth->execute
	or die "Select failed on SQL error " . $dbh->errstr;

    while ($sth->fetch) {
	my $entry = XML::Atom::Entry->new(Version => 1);
	$entry->title($title);
	$entry->summary($excerpt);
	$entry->id('tag:' . $q->server_name . ',2006:' . $q->script_name . '/item/' . $id);
	my $entry_url = $q->url . '/item/' . $id;
	$entry->add_link({ rel => 'alternate', type => 'text/html',
			   href => $entry_url . '?view=html' });
	$entry->add_link({ rel => 'alternate', type => 'application/atom+xml',
			   href => $entry_url });

	$entry->content(qq{$excerpt (<a href="$url" rel="nofollow">Read more</a>)});
	$entry->content->type('xhtml');
	$entry->content->elem->removeAttribute('mode'); # obsolete

	$created_on =~ s/ /T/;
	$entry->published($created_on . 'Z');
	$modified_on =~ s/ /T/;
	$entry->updated($created_on . 'Z');

	my $author = XML::Atom::Person->new(Version => 1);
	$author->set('name', 'nobody');
	$entry->author($author);

	$entry->set($geo_ns, 'lat', $lat);
	$entry->set($geo_ns, 'long', $lng);

	$feed->add_entry($entry);
    }
    $sth->finish;
    return $feed;
}

# trackback
sub post_coords {
    my($this, $args) = @_;
    my($lat, $lng) = ($args =~ m/(-?[\d.]+),(-?[\d.]+)/);

    unless (defined $lat && abs($lat) <= 90 &&
	    defined $lng && abs($lng) <= 180) {
	Net::Trackback::Server->send_error('error');
	return;
    }

    my $q = $this->{cgi};
    my $dbh = $this->{dbh};
#    my $enc = $q->param('charset')
#	if $q->param('charset') && $q->param('charset') !~ m/utf-?8/i;

    my $ping = Net::Trackback::Server->receive_ping($q);

    # check source_url validity
    my $url = valid_url($ping->url);
    unless ($url) {
	Net::Trackback::Server->send_error('error');
	return;
    }

    my $sql = "insert into tbping values (NULL, ?, ?, ?, ?, ?, ?, ?, ?)\n";
    my $sth = $dbh->prepare($sql);
    $sth->bind_param(1, $lat, SQL_FLOAT);
    $sth->bind_param(2, $lng, SQL_FLOAT);
    $sth->bind_param(3, remove_html($ping->title), SQL_VARCHAR);
    $sth->bind_param(4, remove_html($ping->excerpt), SQL_VARCHAR);
    $sth->bind_param(5, $url, SQL_VARCHAR);
    $sth->bind_param(6, remove_html($ping->blog_name), SQL_VARCHAR);
    my @ts = gmtime(time);
    my $created_on = sprintf('%04d-%02d-%02d %02d:%02d:%02d',
			     $ts[5]+1900, $ts[4]+1, @ts[3,2,1,0]);
    $sth->bind_param(7, $created_on, SQL_VARCHAR);
    $sth->bind_param(8, $created_on, SQL_VARCHAR);
    $sth->execute
	or die "Insert failed on SQL error " . $dbh->errstr;
    $sth->finish;
    Net::Trackback::Server->send_success($ping->id);
}

# get item feed
sub get_item {
    my($this, $args) = @_;
    my $q = $this->{cgi};
    my($id) = ($args =~ m/(\d+)/);
    unless ($id) {
	print $q->header('text/html', '403 Forbidden'), "403 Forbidden\n";
	return;
    }

    my $feed = $this->get_item_feed($id);
    if ($q->param('view') eq 'html') {
	print $q->header('text/html');
	my $tmpl = get_tmpl();
	my $tt = Template->new;
	my($lat,$lng) = (35.658586,139.745450);
	if (scalar $feed->entries) {
	    $lat = ($feed->entries)[0]->get($geo_ns, 'lat') || 35.658586;
	    $lng = ($feed->entries)[0]->get($geo_ns, 'long') || 139.745450;
	}
	$tt->process(\$tmpl, { lat => $lat, lng => $lng, ,q => $q,
			       feed => $feed, key => $this->{key} })
	    or print $tt->error;
    } else {
	print $q->header('text/xml'), $feed->as_xml;
    }
}

sub get_item_feed {
    my($this, $item_id) = @_;
    my $q = $this->{cgi};
    my $dbh = $this->{dbh};

    my $feed = XML::Atom::Feed->new(Version => 1);
#    $feed->{doc}->insertProcessingInstruction('xml-stylesheet',
#	qq{type="text/xsl" media="screen" href="$SCREEN_XSL"});

    $feed->title("MapUp item ($item_id)");
    $feed->id('tag:' . $q->server_name . ',2006:' . $q->url(-absolute => 1, -path_info => 1));
    $feed->add_link({ rel => 'self', type => 'application/atom+xml',
		      href => $q->url(-path_info => 1) });
    $feed->add_link({ rel => 'alternate', type => 'text/html',
		      href => $q->url(-path_info => 1) . '?view=html' });
    my @ts = gmtime(time);
    $feed->updated(sprintf('%04d-%02d-%02dT%02d:%02d:%02dZ',
			   $ts[5]+1900, $ts[4]+1, @ts[3,2,1,0]));

    my $sql = "select * from tbping where id = ?\n";

    my $sth = $dbh->prepare($sql);
    my($id, $lat, $lng, $title, $excerpt, $url, $blog_name, $created_on, $modified_on);
    $sth->bind_columns(undef, \($id, $lat, $lng, $title, $excerpt, $url,
		       $blog_name, $created_on, $modified_on));
    $sth->execute($item_id)
	or die "Select failed on SQL error " . $dbh->errstr;

    while ($sth->fetch) {
	my $entry = XML::Atom::Entry->new(Version => 1);
	$entry->title($title);
	$entry->summary($excerpt);
	$entry->id('tag:' . $q->server_name . ',2006:' . $q->script_name . '/item/' . $id);
	my $entry_url = $q->url . '/item/' . $id;
	$entry->add_link({ rel => 'alternate', type => 'text/html',
			   href => $entry_url . '?view=html' });
	$entry->add_link({ rel => 'alternate', type => 'application/atom+xml',
			   href => $entry_url });

	$entry->content(qq{$excerpt (<a href="$url" rel="nofollow">Read more</a>)});
	$entry->content->type('xhtml');
	$entry->content->elem->removeAttribute('mode'); # obsolete

	$created_on =~ s/ /T/;
	$entry->published($created_on . 'Z');
	$modified_on =~ s/ /T/;
	$entry->updated($created_on . 'Z');

	my $author = XML::Atom::Person->new(Version => 1);
	$author->set('name', 'nobody');
	$entry->author($author);

	$entry->set($geo_ns, 'lat', $lat);
	$entry->set($geo_ns, 'long', $lng);

	$feed->add_entry($entry);
    }
    $sth->finish;
    return $feed;
}

# delete item
sub delete_item {
    my($this, $arg) = @_;
    print $this->{cgi}->header('text/html');
    print shift;
}

sub get_tmpl {
    return << 'TMPL';
[% USE JavaScript -%]
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xmlns:v="urn:schemas-microsoft-com:vml">
  <head>
  <meta http-equiv="Content-type" content="text/html; charset=utf-8"/>
  <title>MapUp: Trackback/Atom-enabled Google Map</title>
  <style type="text/css">
    v\:* { behavior:url(#default#VML); }
    * { font-family: 'Lucida Sans', Arial, sans-serif; font-size: 12px; }
    h1 { font-size: 14px; }
    h2 { font-size: 12px; line-height: 1; }
    a img { border: 0; }
  </style>
  <rdf:RDF xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" xmlns:trackback="http://madskills.com/public/xml/rss/module/trackback/">
    <rdf:Description rdf:about="[% q.url %]/coords/[% lat %],[% lng %]" trackback:ping="[% q.url %]/coords/[% lat %],[% lng %]" id="tb_desc" />
  </rdf:RDF>
  <link rel="alternate" type="application/atom+xml" title="Atom" href="[% q.url %]/coords/[% lat %],[% lng %]" id="atom_hlink" />
  </head>
  <body>
  <script src="http://maps.google.com/maps?file=api&amp;v=2&amp;key=[% key %]" type="text/javascript"></script>

<h1>MapUp: Trackback/Atom-enabled Google Map <a href="[% q.url %]/coords/[% lat %],[% lng %]" id="atom_link"><img src="images/feed.png" /></a></h1>

<p>MapUp allows you to send a trackback ping to anywhere you want, and to retrieve Atom feeds for trackback pings recently sent to.</p>

<div id="page" style="position: relative; width: 800px; height: 400px;">
<div id="map" style="width: 100%; height: 400px;"></div>
</div>

<p>Trackback URL: <input type="input" size="80" value="[% q.url %]/coords/[% lat %],[% lng %]" id="tb_url" /></p>

<address>2006, <a href="http://as-is.net/blog/">Hirotaka Ogawa</a>.</address>
    
<script type="text/javascript">
//<![CDATA[
var map = new GMap2(document.getElementById("map"));
map.addControl(new GLargeMapControl());
map.addControl(new GMapTypeControl());
map.setCenter(new GLatLng([% lat %], [% lng %]), 15, G_NORMAL_MAP);
map.addControl(new GOverviewMapControl(new GSize(150,120)));

var tb_desc = document.getElementById("tb_desc");
var tb_url = document.getElementById("tb_url");
var atom_hlink = document.getElementById("atom_hlink");
var atom_link = document.getElementById("atom_link");
GEvent.addListener(map, "moveend", function() {
  var point = map.getCenter();
  var url = "[% q.url %]/coords/" + point.toUrlValue();
  tb_desc.setAttribute('rdf:about', url);
  tb_desc.setAttribute('trackback:ping', url);
  tb_url.value = url;
  atom_hlink.href = url;
  atom_link.href = url;
});

function addMarker(map, lat, lng, html) {
  var point = new GLatLng(lat, lng);
  var marker = new GMarker(point, G_DEFAULT_ICON);
  map.addOverlay(marker);
  GEvent.addListener(marker, 'click', function() {
    marker.openInfoWindowHtml(html);
  });
}

[% FOREACH i = feed.entries %]
addMarker(map, [% i.geo.lat %], [% i.geo.long %], '<h2>[% i.title | js %]</h2> <p>[% i.content.body | js %]</p>');
[% END %]
//]]>
</script>

  </body>
</html>
TMPL
}

sub remove_html {
    my $text = shift;
    return $text if !defined $text;
    $text =~ s!<[^>]+>!!gs;
    $text =~ s!<!&lt;!gs;
    $text;
}

sub valid_url {
    my $url = shift;
    $url =~ s/^\s+//;
    $url =~ s/\s+$//;
    return '' if $url =~ /[ \"]/;

    my ($scheme, $host, $path, $query, $fragment) =
	$url =~ m,(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?,;
    if ($scheme && $host) {
	return $url;
    }
    return '';
}

1;

package main;

my %actions = (
	       'coords' => {
		   'GET' => 'get_coords',
		   'POST' => 'post_coords',
	       },
	       'item' => {
		   'GET' => 'get_item',
		   'DELETE' => 'delete_item',
	       },
	       );

my $mapup = MapUp->new('db/mapup.db', 'ABQIAAAA2SGB7kYAwJ7vNIiGUvsYgBQBbqWMXPd7ku0BIuG8sIWAUrc4NRSFo9YNTIVrCt2PqV-iwm2ShFyasQ');

while (my $q = $mapup->request()) {
    $q->charset('utf-8');

    if ($q->path_info =~ m!^/?$!) {
	print $q->redirect(-uri => $q->url . '/coords/35.658586,139.745450?view=html');
	next;
    }

    my (undef, $class, $args) = split('/', $q->path_info);
    my $method = $q->request_method;
    if (!exists $actions{$class}{$method}) {
	print $q->header('text/html', '403 Forbidden'), "403 Forbidden\n";
	next;
    }

    my $meth = $actions{$class}{$method};
    $mapup->$meth($args);
}

1;
